home *** CD-ROM | disk | FTP | other *** search
/ Leisure Game Pak / Leisure Game Pak.iso / lpgame1 / 04 / source / mynesini.pas < prev    next >
Pascal/Delphi Source File  |  1994-08-17  |  10KB  |  301 lines
  1. (*  .....................................................................  *)
  2. (*  :    file        :  MYNESINI.PAS                                 :  *)
  3. (*  :      contents    :  initialization, palette and HOF for MYNES!    :  *)
  4. (*  :    last update    :  30-JUN-93                                    :  *)
  5. (*  :...................:...............................................:  *)
  6. (*
  7.     - ESC_pressed    ...   used in MYNESGAM and MYNESTTL
  8.     - dim_palette
  9.         - initialize
  10.         - ReadHOF, WriteHOF  ... HallOfFame disk operations
  11.         - print_error
  12. *)
  13.  
  14.  
  15. FUNCTION  ESC_pressed : BOOLEAN; (* TRUE if ESC-key has been pressed *)
  16. BEGIN
  17.   ESC_pressed := KeyPressed AND (ReadKey = #27);
  18. END;
  19.  
  20. (*  dim_palette changes brightness to new_bright (0..100 %)  *)
  21. PROCEDURE    dim_palette(new_bright : WORD; speed : BOOLEAN);
  22.  
  23. PROCEDURE    set_rgbpal(bright : WORD);
  24. CONST    RGBPAL : ARRAY[0..15, 1..3] OF BYTE =
  25.     ( (*  BLACK        DKGREY        GREY  *)
  26.       ($00, $00, $00), ($14, $14, $14), ($28, $28, $28),
  27.           (*  DKBLUE        BLUE        LTBLUE  *)
  28.       ($00, $00, $3f), ($1a, $1a, $3f), ($2a, $2a, $3f),
  29.           (*  visible1 .. visible8  *)
  30.       ($3f, $3f, $00), ($3f, $3a, $04), ($3f, $33, $08), ($3f, $2c, $0c),
  31.       ($3f, $24, $10), ($3f, $17, $14), ($3f, $0a, $18), ($3f, $00, $20),
  32.           (*  visible_mine       WHITE  *)
  33.       ($30, $10, $25), ($3f, $3f, $3f) );
  34.  
  35. VAR    colnr, i : 0..15;
  36.         rgbtemp  : ARRAY[0..15, 1..3] OF BYTE;
  37. BEGIN
  38.     FOR  colnr := 0  TO  15  DO
  39.            FOR i := 1 TO 3 DO
  40.               rgbtemp[colnr, i] := (RGBPAL[colnr,i] * bright DIV 100) AND 63;
  41.  
  42.        XSetPalette(0, 16, rgbtemp);
  43. END;    (*  set_rgbpal  *)
  44.  
  45. CONST   act_bright : WORD = 0;
  46. VAR    step       : SHORTINT;
  47.     diff       : SHORTINT;
  48.  
  49. BEGIN    (*  dim_palette  *)
  50.  
  51.         IF  (speed = SLOW_DIM)  THEN
  52.     BEGIN
  53.             StartMeasure;
  54.                 diff := ABS(INTEGER(act_bright)-new_bright);
  55.  
  56.         IF (act_bright > new_bright)  THEN  step := -DIM_STEP
  57.                           ELSE  step :=  DIM_STEP;
  58.             WHILE  ABS(DIM_STEP) < ABS(INTEGER(act_bright)-new_bright)  DO
  59.         BEGIN
  60.             INC(act_bright, step);
  61.                     set_rgbpal(act_bright);
  62.                     MyDelay(DIM_DELAY);
  63.             END;  (* WHILE *)
  64.  
  65.                 IF  diff = 100  THEN
  66.            GetStepDelay(OPT_DIM_TIME,
  67.                         diff,
  68.                     DIM_STEP,
  69.                     DIM_DELAY);
  70.         END;  (* IF (speed) *)
  71.  
  72.         act_bright := new_bright;
  73.     set_rgbpal(new_bright);
  74. END;    (*  dim_palette  *)
  75.  
  76.  
  77. (* enhanced GADGET routines *)
  78.  
  79. (* initializes gadgets as not_pushed, not_active, in_screen with
  80.    grey background and white text *)
  81. PROCEDURE    init_gadget(VAR   gad          : GADGET_TYPE;
  82.                 x, y, width, height : WORD;
  83.                 text         : STRING;
  84.                             split_at        : BYTE;
  85.                 keep        : BOOLEAN);
  86. BEGIN
  87.     gad.init(x, y, width, height,
  88.              GREY, DKGREY, WHITE,    (* in, upleft, lowright *)
  89.                  GAD_NOT_PUSHED,
  90.                  TRUE,            (*  mouse checking on *)
  91.                  keep,
  92.          text, split_at, WHITE); (* text, split_position, textcol *)
  93. END;    (*  init_gadget  *)
  94.  
  95.  
  96. PROCEDURE    init_all_gadgets;
  97. VAR    g : BYTE;
  98. BEGIN
  99.     (*  gad, x, y, width, height, text *)
  100.       init_gadget(GAME_QUIT_GADGET, 570, 426, 50, 12, 'QUIT', 0, GAD_NO_KEEP);
  101.       init_gadget(GAME_PAUSE_GADGET,570, 443, 50, 12, 'PAUSE', 0, GAD_NO_KEEP);
  102.       init_gadget(GAME_DEMO_GADGET, 570, 460, 50, 12, 'DEMO', 0, GAD_NO_KEEP);
  103.  
  104.         (*  the distance between two gadgets is 20 pix  *)
  105.       init_gadget(TITLE_QUIT_GADGET,  10, TITLE_GAD_Y, 64, 20, 'QUIT', 0, GAD_NO_KEEP);
  106.       init_gadget(TITLE_START_GADGET, 94, TITLE_GAD_Y, 72, 20, 'START', 0, GAD_NO_KEEP);
  107.       init_gadget(TITLE_DEMO_GADGET, 186, TITLE_GAD_Y, 64, 20, 'DEMO', 0, GAD_NO_KEEP);
  108.         (* the SOUND ON/SOUND OFF text is split behind the 9th character .............v *)
  109.       init_gadget(TITLE_MUSIC_GADGET,270, TITLE_GAD_Y, 100, 20, 'SOUND OFFSOUND ON', 9, GAD_KEEP);
  110.         TITLE_MUSIC_GADGET.set_state(SoundIsOn);    (* set actual mode *)
  111.       init_gadget(TITLE_LOOK_GADGET, 390, TITLE_GAD_Y, 88, 20, 'MP-LOOKPL-LOOK', 7, GAD_KEEP);
  112.         TITLE_LOOK_GADGET.set_state(LookIsPL);
  113.       init_gadget(TITLE_HOF_GADGET,  498, TITLE_GAD_Y, 130, 20, 'HALL OF FAME', 0, GAD_NO_KEEP);
  114.  
  115.         (* set the radio-gadgets and activate the first of each type *)
  116.         FOR  g := FIRSTLEVEL  TO  LASTLEVEL  DO
  117.             LEVEL_GAD[g].init(90 + g * 60, LEVEL_GAD_Y, 40, 40,
  118.                      NO_FILL, BLACK, WHITE,    (* in, upleft, lowright *)
  119.                          (g = Level),         (* set actual setting *)
  120.                          TRUE,            (* mouse checking on *)
  121.                          GAD_KEEP,
  122.                  '', 0, WHITE);        (*  text, split, textcol  *)
  123.  
  124.         FOR  g := 1  TO  5  DO
  125.             init_gadget(SPEED_GAD[g], 38 + g * 98, SPEED_GAD_Y, 90, 20, SPEEDSTR[g], 0, GAD_KEEP);
  126.  
  127.         (*  set the actual Speed that has just been read from HOF-file  *)
  128.         SPEED_GAD[Speed].set_state(GAD_PUSHED);
  129.  
  130. END;    (*  init_all_gadgets  *)
  131.  
  132.  
  133. (*  the new exit procedure, releases memory and graphics  *)
  134. {$F+}
  135. PROCEDURE    MynesExitProc;
  136. BEGIN
  137.         (*  release resources ... *)
  138.         FreeMem(TileImage[PUSHED_TILE], MaxTileSize);
  139.         FreeMem(TileImage[NOT_PUSHED_TILE], MaxTileSize);
  140.  
  141.         CloseGraph;    (* close graphics *)
  142.         RestoreCrtMode; (* restore old video mode *)
  143.  
  144.     WRITELN('╔═════════════────────────┐');
  145.     WRITELN('║  Thank you for playing  │');
  146.     WRITELN('│   Marc Palms'' MYNES!    ║');
  147.     WRITELN('└─────────────════════════╝'#13);
  148.  
  149.         (*  call the old exit procedure  *)
  150.         ExitProc := OldExitProc;
  151. END;    (*  MynesExitProc  *)
  152. {$F-}
  153.  
  154.  
  155. PROCEDURE    ReadHOFfile;    (* reads the Hall Of Fame *)
  156. VAR    HOFfile    : FILE OF DISK_FILE_TYPE;
  157.     filerec : DISK_FILE_TYPE;
  158.         entry   : BYTE;
  159.         Dir    : DirStr;
  160.     Name    : NameStr;
  161.       Ext    : ExtStr;
  162. BEGIN
  163.     (* initialize HallOfFame, Sound/Look and Level/Speed defaults *)
  164.         FOR  entry := 1  TO  HOF_SIZE  DO
  165.                 HallOfFame[entry] := HOF_DEFAULT;
  166.         Level := FIRSTLEVEL;
  167.         Speed := FIRSTSPEED;
  168.         SoundIsON := FALSE;
  169.         LookIsPL  := FALSE;
  170.  
  171.         (* generate complete HOF-Path *)
  172.     FSplit(ParamStr(0), Dir, Name, Ext);
  173.         HOF_PathName := Dir + HOF_FILENAME;
  174.  
  175.         (* read HALLofFAME *)
  176.         Assign(HOFfile, HOF_PathName);
  177.         {$I-}
  178.         Reset(HOFfile);
  179.  
  180.         {$IFDEF debug}
  181.     {$I+  switch on IO checking again }
  182.     {$ENDIF}
  183.         IF  (IOResult = 0)  AND
  184.         (FileSize(HOFfile) = 1)  THEN
  185.         BEGIN
  186.             HOFexists := TRUE;
  187.             (* now, read the file *)
  188.             Read(HOFfile, filerec);
  189.             Close(HOFfile);
  190.             HallOfFame:= filerec.HOF;
  191.             Level     := filerec.Level;
  192.                 IF  (Level > LASTLEVEL)  OR
  193.                     (Level < FIRSTLEVEL)  THEN  Level := FIRSTLEVEL;
  194.  
  195.             Speed       := filerec.Speed;
  196.                 IF  (Speed > LASTSPEED)  OR
  197.             (Speed < FIRSTSPEED)  THEN  Speed := FIRSTSPEED;
  198.  
  199.             LookIsPL  := filerec.LookIsPL;
  200.             SoundIsOn := filerec.SoundIsOn;
  201.         END
  202.         ELSE    HOFexists := FALSE;
  203.  
  204. END;    (*  ReadHOFfile  *)
  205.  
  206.  
  207. PROCEDURE    WriteHOFfile;    (* writes the Hall Of Fame *)
  208. VAR    HOFfile    : FILE OF DISK_FILE_TYPE;
  209.     filerec : DISK_FILE_TYPE;
  210. BEGIN
  211.    (* Save Hall Of Fame only if it EXISTED or if a there is a new HIGH *)
  212.    IF  HOFexists  THEN
  213.    BEGIN
  214.         Assign(HOFfile, HOF_PathName);
  215.         {$I-}
  216.         Rewrite(HOFfile);
  217.         {$IFDEF debug}
  218.     {$I+  switch on IO checking again }
  219.     {$ENDIF}
  220.  
  221.         IF  (IOResult = 0)  THEN
  222.         BEGIN
  223.             filerec.LookIsPL  := LookIsPL;
  224.             filerec.SoundIsOn := SoundIsOn;
  225.             filerec.Level     := Level;
  226.             filerec.Speed       := Speed;
  227.             filerec.HOF      := HallOfFame;
  228.             (* now, write the file *)
  229.                 Write(HOFfile, filerec);
  230.             Close(HOFfile);
  231.         END;  (* IF IOResult *)
  232.    END; (* IF HOFexists *)
  233. END;    (*  WriteHOFfile  *)
  234.  
  235.  
  236. (* print an error message and HALT program *)
  237. PROCEDURE    print_error(missing : STRING);
  238. BEGIN
  239.           WRITELN(#13'Sorry, but  MYNES !  needs ',missing,' ... EXITING.'#13);
  240.         HALT(1);
  241. END;    (*  print_error  *)
  242.  
  243.  
  244. (* the VGA driver is built-in *)
  245. PROCEDURE    VGADriver;  EXTERNAL;    {$L EGAVGA.OBJ}
  246.  
  247.  
  248. (* initialize graphics, mouse, memory, HallOfFame ... *)
  249. PROCEDURE    initialize;
  250.  
  251. VAR    GrDevice, GrMode: INTEGER;
  252.     color, dummy,
  253.     entry        : BYTE;
  254.     HOFfile        : FILE;
  255.         h, m, s, hs    : WORD;
  256.         time1, time2,
  257.         time_dif,
  258.     normal_time    : LONGINT;
  259. BEGIN
  260.     IF  NOT(HasMouse)  THEN  print_error('a MOUSE');
  261.  
  262.         (* I don't even know whether this error can ever happen ... *)
  263.     IF  (RegisterBGIdriver(@VGADriver) < 0)  THEN  print_error('HELP');
  264.  
  265.     GrDevice := VGA;  GrMode := VGAHi;
  266.     InitGraph(GrDevice, GrMode, '');
  267.  
  268.     IF  (GraphResult <> grOk)  THEN  print_error('VGA');
  269.  
  270.         MIDDLE_X := GetMaxX DIV 2;    (* for x-centered text *)
  271.  
  272.         MaxTileSize := ImageSize(1, 1, Scene_ARRAY[FIRSTLEVEL].Size.x,
  273.                          Scene_ARRAY[FIRSTLEVEL].Size.y);
  274.  
  275.         IF  (MaxAvail < 2 * MaxTileSize)  THEN
  276.     BEGIN
  277.         CloseGraph;
  278.         print_error('more MEMORY');
  279.         END;  (* IF *)
  280.  
  281.     GetMem(TileImage[PUSHED_TILE], MaxTileSize);
  282.     GetMem(TileImage[NOT_PUSHED_TILE], MaxTileSize);
  283.  
  284.         (*  now it's time to install the new exit procedure, if something goes
  285.         wrong in future everything will be cleared up afterwards  *)
  286.         OldExitProc := ExitProc;
  287.     ExitProc := @MynesExitProc;
  288.  
  289.     ReadHOFfile;  (* read HallOfFame BEFORE initializing the gagdets,
  290.              to be able to initialize the actual settings for
  291.              Level/Speed and Sound/Look *)
  292.         init_all_gadgets;
  293.         Randomize;
  294.         (*  set the new palette  *)
  295.         FOR  color := 0  TO  MaxColors  DO
  296.             SetPalette(color, color);      (*  normalize palette  *)
  297.         dim_palette(0, FAST_DIM);        (*  and set it fast  *)
  298.  
  299.     (* -- adjust VGA-dimming-speed for this machine *)
  300. END;    (*  initialize  *)
  301.